module Structures where 

import Test.QuickCheck
import Data.Maybe
import PGF
import System.Random
import Control.Monad 
import Data.List


type Syllogism = [Sentence]

data Sentence =  SaP {subject :: SSubject, predicate :: SProperty}
               | SoP {subject :: SSubject, predicate :: SProperty}
               | SiP {subject :: SSubject, predicate :: SProperty}
               | SeP {subject :: SSubject, predicate :: SProperty}
               | CnP {name    :: SSubject, predicate :: SProperty}
               | CpP {name    :: SSubject, predicate :: SProperty}
   deriving Show

data SSubject = Sub String | SPhrase String String
   deriving Show
data SProperty = And {p1 :: String, p2 :: String}
               | Or {p1 :: String, p2 :: String}
               | PPhrase {p1 ::String, p2 :: String}
               | Prop String
   deriving Show

data Answer = ATrue | AFalse | AContr | AInconc | AMissing
   deriving Eq

type TPTP     = String
type Formula  = String
type Variable = String
type Operator = Char

showAnswer :: Answer -> String
showAnswer ATrue    = "True"
showAnswer AFalse   = "False"
showAnswer AMissing = "Missing"
showAnswer AContr   = "Contradictory"
showAnswer AInconc  = "Inconclusive"

instance Show Answer where
   show ATrue    = "True"
   show AFalse   = "False"
   show AMissing = "Missing"
   show AContr   = "Contradictory"
   show AInconc  = "Inconclusive"

{-
instance Show Syllogism where
    show (Syl sents) = intercalate "\n" (init $ map show sents)
                       ++ "\nThen: " ++ show (last sents)++"\n"

instance Show Sentence where
  show (SaP s p) = "All "++ s ++ " is " ++ show p
  show (SoP s p) = "Some "++ s ++ " is not " ++ show p
  show (SeP s p) = "No "++ s ++ " is " ++ show p
  show (SiP s p) = "Some "++ s ++ " is " ++ show p
  show (CpP s p) =  s ++ " is " ++ show p
  show (CnP s p) =  s ++ " is not " ++ show p


instance Show SProperty where
  show (And p1 p2) = p1 ++ " and " ++ p2
  show (Or  p1 p2) = p1 ++ " or " ++ p2
  show (Prop p)    = p

instance Show SSubject where
  show (Sub p1) = p1
  show (SPhrase  p1 p2) = p1 ++ p2
-}


{-
Generates a syllogism with n axioms, where n words and m names is used.
-}

{-
instance Arbitrary Syllogism where
   arbitrary = do
              n     <- choose (3,10)
              m     <- choose (1,3)
              subs  <- arbitrarySub n
              names <- arbitraryN n
              props <- arbitraryProp m subs
              sents <- arbitraryS n subs names props
              return $ Syl sents


test :: IO ()
test = sample (arbitrary :: Gen Syllogism) 

arbitraryW, arbitraryN :: Int -> Gen [String]
arbitraryW = flip arbitraryChars ['A'.. 'K']
arbitraryN = flip arbitraryChars ['X'..'Z']

arbitrarySub :: Int -> Gen [String]
arbitrarySub = flip arbitraryChars $ ['A'..'K']++['X'..'Z']

arbitraryChars :: Int -> [Char] -> Gen [String]
arbitraryChars n = replicateM n . elements . map (:[])


arbitraryProp :: Int -> [String] -> Gen [String]
arbitraryProp n prop = replicateM n $ arbitraryPs 3 prop
-- some sort of sized arbitrary
arbitraryPs :: Int -> [String] -> Gen String
arbitraryPs s prop = do
  p <- elements prop
  frequency [(1,return p),
             (s,do
                p1 <- arbitraryPs (div s 2) prop
                p2 <- arbitraryPs (div s 2) prop
                return $ p1 ++ " and " ++ p2),
             (s,do
                p1 <- arbitraryPs (div s 2) prop
                p2 <- arbitraryPs (div s 2) prop
                return $ p1 ++ " or " ++ p2)
           ]

arbitraryS :: Int -> [String] -> [String] -> [String] -> Gen [Sentence]
arbitraryS n strs names props = replicateM n $ arbSentence strs names props

arbSentence :: [String] -> [String] -> [String] -> Gen Sentence
arbSentence subs names props = do
   w1 <- elements subs
   w2 <- elements names
   w3 <- elements props
   name <- elements names
   frequency [(2, return $ SaP w1 w3),
              (2, return $ SeP w1 w3),
              (2, return $ SoP w1 w3),
              (2, return $ SiP w1 w3),
              (1, return $ CnP name w3),
              (1, return $ CpP name w3)
              ]

-}
